home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / RUBBER.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-09  |  3KB  |  132 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Tips & Techniques Demo Program               }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. Program Rubberband;
  10.  
  11. uses WinTypes, WinProcs, WObjects;
  12.  
  13. type
  14.   TApp  = object (TApplication)
  15.     procedure InitMainWindow; virtual;
  16.   end;
  17.  
  18.   PRubberWin = ^TRubberWin;
  19.   TRubberWin = object(TWindow)
  20.     DC : HDC;
  21.     PS : TPaintStruct;
  22.     ABrush: hBrush;
  23.     APen: hPen;
  24.     OTrack, Track : boolean;
  25.     NextX, NextY, OrgX, OrgY, PrevX, PrevY, X, Y, SX, SY : longint;
  26.     procedure Destroy; virtual;
  27.     procedure SetupWindow; virtual;
  28.     procedure WMLButtonDown(var Message: TMessage);
  29.       virtual wm_First + wm_LButtonDown;
  30.     procedure WMLButtonUp(var Message: TMessage);
  31.       virtual wm_First + wm_LButtonUp;
  32.     procedure WMMouseMove(var Message: TMessage);
  33.       virtual wm_First + wm_MouseMove;
  34.   end;
  35.  
  36. procedure TApp.InitMainWindow;
  37. begin
  38.   MainWindow := New(PRubberWin, Init(Nil,'RUBBER BAND'));
  39. end;
  40.  
  41. procedure TRubberWin.Destroy;
  42. begin
  43.   TWindow.Destroy;
  44.   DeleteObject(ABrush);
  45.   DeleteObject(APen);
  46. end;
  47.  
  48. procedure TRubberWin.SetupWindow;
  49. begin
  50.   Track := False;
  51.   OTrack := True;
  52.   OrgX := 0;
  53.   OrgY := 0;
  54.   PrevX := 0;
  55.   PrevY := 0;
  56.   X := 0;
  57.   Y := 0;
  58.   SX := 0;
  59.   SY := 0;
  60.   ABrush := CreateSolidBrush(RGB(255, 0, 0));
  61.   APen := CreatePen(ps_Solid, 1, RGB(0, 0, 255));
  62. end;
  63.  
  64. procedure TRubberWin.WMLButtonDown(var Message: TMessage);
  65. begin
  66.   Track := True;
  67.   with Message do
  68.   begin
  69.     PrevX := lParamLo;
  70.     PrevY := lParamHi;
  71.     OrgX := PrevX;
  72.     OrgY := PrevY;
  73.  
  74.     if OTrack then
  75.     begin
  76.       SX := lParamLo;
  77.       SY := lParamHi;
  78.       OTrack := False;
  79.     end;
  80.     SetCapture(HWindow);
  81.   end;
  82. end;
  83.  
  84. procedure TRubberWin.WMLButtonUp(var Message: TMessage);
  85. var
  86.   OldPen: HPen;
  87.   OldBrush: HBrush;
  88. begin
  89.   Track := False;
  90.   OTrack := True;
  91.   ReleaseCapture;
  92.   X := integer(Message.lParamLo);
  93.   Y := integer(Message.lParamHi);
  94.   DC := GetDC(HWindow);
  95.   OldPen := SelectObject(DC, APen);
  96.   OldBrush := SelectObject(DC, ABrush);
  97.   if (OrgX <> X) or (OrgY <> Y) then
  98.     Ellipse(DC, OrgX, OrgY, X, Y);
  99.   SelectObject(DC, OldPen);
  100.   SelectObject(DC, OldBrush);
  101.   ReleaseDC(HWindow, DC);
  102. end;
  103.  
  104. procedure TRubberWin.WMMouseMove(var Message: TMessage);
  105. begin
  106.   if Track then
  107.   begin
  108.     NextX := integer(Message.lParamLo);
  109.     NextY := integer(Message.lParamHi);
  110.     if (NextX <> PrevX) or (NextY <> PrevY) then
  111.     begin
  112.       DC := GetDC(HWindow);
  113.       SetROP2(DC, r2_NOT);
  114.       SelectObject(DC, GetStockObject(null_Brush));
  115.       Ellipse(DC, OrgX, OrgY, PrevX, PrevY);
  116.       PrevX := NextX;
  117.       PrevY := NextY;
  118.       Ellipse(DC, SX, SY, PrevX, PrevY);
  119.       ReleaseDC(HWindow, DC);
  120.     end;
  121.   end;
  122. end;
  123.  
  124. var
  125.   App: TApp;
  126.  
  127. begin
  128.   App.Init('Rubber Band');
  129.   App.Run;
  130.   App.Done;
  131. end.
  132.